Utilities Professional 1-1500/Utilities Professional 1-1500 (1994)(WPD)[!].iso/12511500/var1390.dms/var1390.adf/bs.AMOS/bs.amosSourceCode

AMOS Source Code | 1994-01-24 | 12KB | 613 lines

Reserve As Work 8,1024
Dim SH(40)
Dim SQ(40)
Global MZ,MK,RZ,ISTR,PTCH,SH(),SQ(),SHIFTY,OFFS,LOD,T,B,ANS$,MX,SWINE,RD,TMP,SAVVY
SKANK
Procedure FUNKY
   Show On
   Volume 63
   Screen Open 0,320,250,16,Lowres
   Curs Off : Flash Off : Cls 0
   Get Icon Palette
   For N=31 To 39 : Make Icon Mask N : Next N
   Pen 4 : Paper 3
   Ink 6,3
   Colour 17,$333 : Colour 18,$666 : Colour 19,$0
   SAVVY=True : SHIFT=False : LOD=False : B=12 : T=19 : OFFS=0 : SWINE=11 : MX=0
   Set Dir 10,"*.sqz"
End Proc
Procedure SOFA
   Reserve Zone 60
   DRBUT
   Z=21
   For M=70 To 196 Step 32
      For N=1 To 10
         Paste Icon((N*32)-31),M,40
         Set Zone Z,((N*32)-31),M To N*32,M+32
         Inc Z
      Next N
   Next M
   Paste Icon 1,198,42
   Paste Icon 288,198,43
   WRITE
End Proc
Procedure MOUSEY
   MZ=0 : MK=0
   Repeat
      MZ=Mouse Zone
      MK=Mouse Key
   Until Mouse Click and MK>0 and MZ>0
End Proc
Procedure SKANK
   FUNKY
   SOFA
   JUMP
   Do
      Limit Mouse 135,56 To 441,104
      MOUSEY
      RZ=MZ
      SWITCH
      On MZ Proc QUIT,HEAR,DUMB,GRAB,CRANK,CRUNCH,DUMP,SWIPE,PLST,JUMP,SHIFT,PLINK,PLINK,PLINK,PLINK,PLINK,PLINK,PLINK,PLINK,JUMP
   Loop
End Proc
Procedure QUIT
   If SAVVY=False
      CONF["    Quit! Without Saving it!"]
   Else
      If ANS$="y" or SAVVY=True
         CONF["    Quit Beat Sheets! "]
      End If
   End If
   If ANS$="y"
      Volume 10
      Cls 0 : Run "ram:over_to"
   End If
End Proc
Procedure DUMB
   SWITCH
End Proc
Procedure GRAB
   Wind Save
   Wind Open 1,16,16,38,8
   Curs Off
   Border 4,2,0
   Pen 14 : Paper 2
   Clw
   Print : Print "    M I D I...."
   Print : Print
   Print "  M"; : Pen 0
   Print "oney "; : Pen 14
   Print "I"; : Pen 0
   Print "s "; : Pen 14
   Print "D"; : Pen 0
   Print "efinitely "; : Pen 14
   Print "I"; : Pen 0
   Print "nspirational!"
   Print : Print "  Click if a cheque is in the post"; : Pen 14
   Print "! "
   Repeat
   Until Mouse Click
   Wind Close
End Proc
Procedure CRANK
   Dir$="DF0:Sheets/"
   F$=Fsel$("",F$,"LOAD A SONG","Double Click on Title")
   If F$=""
      Bell 10
      Pop Proc
   End If
   Load F$,8
   MX=Peek(Start(8))
   F$=F$+".sqz"
   Open In 1,F$
   For N=0 To 40
      Input #1,SQ(N)
   Next N
   Close 1
   OFFS=0
   LOOKING
   PRETTY
   Dir$="df0:"
   SAVVY=True
End Proc
Procedure CRUNCH
   Dir$="df0:sheets/"
   F$=Fsel$("",F$,"SAVE A SONG","Type Title - Press RETURN")
   If F$=""
      Bell 10
      Pop Proc
   End If
   Poke Start(8),MX
   SQ(0)=TMP
   Change Mouse 3
   Save F$,8
   F$=F$+".sqz"
   Open Out 1,F$
   For N=0 To 40
      Print #1,SQ(N)
   Next N
   Close 1
   Dir$="df0:"
   SAVVY=True
   Change Mouse 1
End Proc
Procedure DUMP
   If MK=2
      If OFFS>0
         Dec OFFS
         LOOKING
         PRETTY
      Else
         Bell 10
      End If
   Else
      BUMP
      If OFFS<21
         Inc OFFS
         If OFFS>MX
            Inc MX
         Else
            LOOKING
            PRETTY
         End If
      End If
   End If
   WRITE
End Proc
Procedure SWIPE
   Limit Mouse
   RZ=MZ
   If MK=2
      CANF
      If ANS$="0"
         WIPE
         BLANK
      End If
      If ANS$="1"
         If SAVVY=False
            CONF[" Wipe!  Without Saving it!"]
            If ANS$="y"
               SAVVY=True
            End If
         End If
         If SAVVY=True
            For N=1 To 1000
               Poke Start(8)+N,0
            Next N
            OFFS=0 : MX=1
            For N=0 To 40 : SQ(N)=0 : Next N
            WIPE
            BLANK
            WRITE
         End If
      End If
   Else
      BLINK
      MZ=RZ
      SWITCH
      SAVVY=False
   End If
End Proc
Procedure BUMP
   ST=Start(8)+(OFFS*40)
   For N=1 To 40
      Poke ST+N,SH(N)
   Next N
End Proc
Procedure PLINK
   SAVVY=False
   ISTR=MZ-11
   If SHIFTY
      ISTR=ISTR+8
   End If
   If ISTR=16 Then ISTR=ISTR+KOS
   Sam Play %1000,ISTR,10000
   CULERIT
   PLONK
End Proc
Procedure SWITCH
   R=1 : SWP=(RZ*32)-31
   If RZ>10
      R=32 : SWP=((RZ-10)*32)-31
   End If
   Paste Icon SWP,R,39
   Wait 5
   If SHIFTY and MZ>11 and MZ<20 Then RZ=RZ+10
   Paste Icon SWP,R,RZ
   If MZ<12 or MZ>19
      Sam Play 1,17,9000
   End If
End Proc
Procedure SHIFT
   If SWINE=11 Then SWINE=41 Else SWINE=11
   Paste Icon 1,32,SWINE
   M=32
   If SHIFTY
      B=12 : T=19
      SHIFTY=False
   Else
      B=22 : T=29
      SHIFTY=True
   End If
   For N=B To T
      Paste Icon M,32,N
      Add M,32
   Next N
End Proc
Procedure CULERIT
   M=32
   For N=31 To 38
      Paste Icon M,32,30
      Paste Icon M,32,N
      Add M,32
   Next N
   Limit Mouse 167,95 To 410,100
   MOUSEY
   PTCH=MZ-11
   Sam Play %1000,ISTR,(PTCH+11)*800
   M=32
   For N=B To T
      Paste Icon M,32,N
      Add M,32
   Next N
End Proc
Procedure PLONK
   Limit Mouse 133,124 To 442,240
   Repeat
      MOUSEY
   Until MZ>20
   RZ=MZ : RST=ISTR
   ISH=11
   If SHIFTY Then ISH=ISH+2
   X=MZ/10 : X=MZ-(X*10) : If X=0 Then X=10
   Y=MZ-X
   X=(X*32)-31
   Y=Y/10-1
   Y=70+((Y*32)-32)
   Paste Icon X,Y,ISTR+ISH
   Paste Icon X,Y,PTCH+30
   If SHIFTY Then ISTR=ISTR-8
   ISTR=ISTR*10
   If SHIFTY Then ISTR=ISTR+100
   SH(RZ-20)=ISTR+PTCH
   If RZ<41 Then TK=%1000 Else TK=%100
   Sam Play TK,RST,(PTCH+11)*800
   Wait 15
End Proc
Procedure HEAR
   Paste Icon 32,1,39
   Limit Mouse
   Wait 10
   Y Mouse=77 : X Mouse=215
   TMP=SQ(0)
   If TMP=0 Then TMP=13
   If MK=2
      PUNKY
   Else
      Do
         BX=10 : BY=68
         MZ=Mouse Zone
         MK=Mouse Key
         If MZ=3 and MK>0
            Exit
         End If
         BO=1 : TP=31
         For N=1 To 10
            Bob 1,BX,BY,1
            Add BX,32
            Restore
            For M=BO To TP Step 10
               If X Mouse<140
                  TMP=Y Mouse-30 : TMP=TMP/10
               End If
               SS=0
               ZZ=SH(M)
               Read TK
               If ZZ>0
                  If ZZ>90
                     SS=8 : ZZ=ZZ-100
                  End If
                  II=(ZZ/10) : PP=ZZ-(II*10)
                  Sam Play TK,II+SS,((PP+11)*800)
               End If
            Next M
            Inc BO : Inc TP
            Wait TMP
         Next N
      Loop
   End If
   Bob Off
   Paste Icon 32,1,2
   RZ=MZ : SWITCH
   Data %1000,%1,%10,%100
End Proc
Procedure WIPE
   For M=70 To 196 Step 32
      For N=1 To 10
         Paste Icon((N*32)-31),M,40
      Next N
   Next M
   For N=1 To 40 : SH(N)=0 : Next N
End Proc
Procedure BLINK
   Paste Icon 225,1,39
   Y Mouse=200
   Do
      Repeat
         MZ=Mouse Zone
         If Y Mouse<110 Then MZ=8
      Until(Mouse Click and MZ>20) or MZ=8
      Exit If MZ=8
      X=MZ/10 : X=MZ-(X*10) : If X=0 Then X=10
      Y=MZ-X
      X=(X*32)-31
      Y=Y/10-1
      Y=70+((Y*32)-32)
      Paste Icon X,Y,40
      Sam Play 1,17,9000
      SH(MZ-20)=0
   Loop
End Proc
Procedure CONF[TT$]
   ANS$=""
   Wind Save
   Wind Open 1,16,16,36,8
   Curs Off
   Border 4,2,0
   Pen 0 : Paper 2
   Clw
   Title Top TT$
   Print : Print
   Print "        Are you really sure?    "
   Print
   Print "          Press "; : Pen 14
   Print "Y "; : Pen 0
   Print "if yes " : Print
   Print "      or any other key for no.";
   Clear Key
   Repeat
      ANS$=Inkey$
   Until ANS$<>""
   ANS$=Lower$(ANS$)
   Wind Close
End Proc
Procedure BLANK
   For N=0 To 40
      SH(N)=0
      SQ(N)=0
   Next N
End Proc
Procedure WRITE
   T$=Str$(OFFS+1)
   If OFFS+1<10
      T$=Right$(T$,1)
      T$="00"+T$
   Else
      T$=Right$(T$,2)
      T$="0"+T$
   End If
   Text 197,24,T$
End Proc
Procedure PUNKY
   OFFS=0 : CSQ=1
   If SQ(1)>0 Then OFFS=SQ(CSQ)-1
   Do
      Timer=0
      WRITE
      LOOKING
      PRETTY
      MZ=Mouse Zone
      MK=Mouse Key
      If MZ=3 and MK>0
         Exit
      End If
      BO=1 : TP=31
      BX=10 : BY=68
      Repeat : Until Timer=>TMP
      For N=1 To 10
         Bob 1,BX,BY,1
         Restore
         For M=BO To TP Step 10
            If X Mouse<140
               TMP=Y Mouse-30 : TMP=TMP/10
            End If
            SS=0
            ZZ=SH(M)
            Read TK
            If ZZ>0
               If ZZ>90
                  SS=8 : ZZ=ZZ-100
               End If
               II=(ZZ/10) : PP=ZZ-(II*10)
               Sam Play TK,II+SS,((PP+11)*800)
            End If
         Next M
         If N<10
            Wait TMP
         End If
         Inc BO : Inc TP : Add BX,32
      Next N
      If SQ(1)>0
         Inc CSQ
         OFFS=SQ(CSQ)-1
         If OFFS=-1
            CSQ=1
            OFFS=SQ(CSQ)-1
         End If
      Else
         Add OFFS,1,0 To MX-1
      End If
      Bob Off
   Loop
   Data %1000,%1,%10,%100
End Proc
Procedure PRETTY
   CN=1
   For M=70 To 196 Step 32
      For N=1 To 10
         ZZ=SH(CN)
         SS=0
         If ZZ>0
            If ZZ>90
               SS=10 : ZZ=ZZ-100
            End If
            II=(ZZ/10) : PP=ZZ-(II*10)
         Else
            II=29
         End If
         Paste Icon((N*32)-31),M,II+11+SS
         If ZZ>0
            Paste Icon((N*32)-31),M,PP+30
         End If
         Inc CN
      Next N
   Next M
End Proc
Procedure LOOKING
   ST=Start(8)+(OFFS*40)
   For N=1 To 40
      SH(N)=Peek(ST+N)
   Next N
End Proc
Procedure CANF
   Wind Save
   Wind Open 1,16,16,36,8
   Curs Off
   Border 4,2,0
   Pen 0 : Paper 2
   Clw
   Print
   Print "    Press "; : Pen 14
   Print "0 "; : Pen 0
   Print "to clear this sheet"
   Print
   Print "   or "; : Pen 14
   Print "1 "; : Pen 0
   Print "to clear the whole song. " : Print
   Print "  Press "; : Pen 14
   Print "N "; : Pen 0
   Print "if it is all a mistake!"
   Clear Key
   Repeat
      ANS$=Inkey$
   Until(ANS$="1") or(ANS$="0") or(ANS$="n")
   Wind Close
End Proc
Procedure JUMP
   Wind Save
   Wind Open 1,16,16,36,8
   Curs Off
   Border 4,2,0
   Pen 0 : Paper 2
   Clw
   Print : Print
   Print "            BEAT SHEETS" : Print
   A$="  Copyright "
   A$=A$+Chr$(169)
   A$=A$+" 1993   Duncan Moran"
   Print A$
   Print : Print
   Print "         Click to continue"
   Repeat
   Until Mouse Click
   Wind Close
End Proc
Procedure PLST
   M=1
   For N=1 To 10
      Paste Icon M,1,21
      N$=Str$(N)
      If N<10 Then N$=" "+N$
      If N<=MX
         Text M+3,12,N$
      End If
      Add M,32
   Next N
   M=1
   For N=11 To 20
      Paste Icon M,32,21
      N$=Str$(N)
      If N<=MX
         Text M+3,43,N$
      End If
      Add M,32
   Next N
   Get Block 1,1,1,319,64
   If MX<2
      CONF[" Make a list from just one sheet!"]
      DRBUT
      Pop Proc
   End If
   If SQ(1)<>0
      CONF["   Destroy existing sequence!"]
      If ANS$<>"y"
         DRBUT : Pop Proc
      End If
   End If
   Limit Mouse
   For N=1 To 40 : SQ(N)=0 : Next N
   Y Mouse=272
   Wind Save
   Wind Open 1,16,76,36,12
   Curs Off
   Border 4,2,0
   Pen 0 : Paper 2
   Clw
   Print : Print
   Print "         Sheet Sequencer   "
   Print : Print
   Print "  Click on the sheet numbers above " : Print
   Print " in the order you want them played." : Print : Print
   Print "   Click DOWN HERE when finished "
   Wait 25
   Repeat : Until Y Mouse<110
   Wind Close
   C=1
   Limit Mouse
   ZM=0
   Do
      Repeat
         MZ=Mouse Zone
         If MZ<>ZM and MZ>0 and MZ<21
            OFFS=MZ-1
            LOOKING
            PRETTY
            ZM=MZ
         End If
      Until Mouse Click and MZ>0
      Exit If MZ>20 or C=40
      If MZ<=MX
         SQ(C)=MZ : RZ=MZ
         Sam Play 15,17,9000
         R=1 : SWP=(RZ*32)-31
         If RZ>10
            R=32 : SWP=((RZ-10)*32)-31
         End If
         Paste Icon SWP,R,39
         Wait 5
         Put Block 1
         Inc C
      Else
         Bell 10
      End If
   Loop
   Del Block 1
   DRBUT
   OFFS=0
   WRITE
End Proc
Procedure DRBUT
   M=1
   For N=1 To 10
      Paste Icon M,1,N
      Set Zone N,M,1 To M+31,32
      Add M,32
   Next N
   M=1
   For N=11 To 20
      Paste Icon M,32,N
      Set Zone N,M,32 To M+31,64
      Add M,32
   Next N
   SHIFTY=False : SWINE=11 : B=12 : T=19
End Proc